home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / forms / dmoc3d / democt3d.frm < prev    next >
Text File  |  1995-03-26  |  11KB  |  318 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   3  'Fixed Double
  5.    Caption         =   "Demo CTL3DV2.DLL"
  6.    ClientHeight    =   3495
  7.    ClientLeft      =   900
  8.    ClientTop       =   1635
  9.    ClientWidth     =   8220
  10.    ControlBox      =   0   'False
  11.    Height          =   3900
  12.    Icon            =   DEMOCT3D.FRX:0000
  13.    Left            =   840
  14.    LinkTopic       =   "Form1"
  15.    MaxButton       =   0   'False
  16.    ScaleHeight     =   3495
  17.    ScaleWidth      =   8220
  18.    Top             =   1290
  19.    Width           =   8340
  20.    Begin OptionButton Option1 
  21.       BackColor       =   &H00C0C0C0&
  22.       Caption         =   "3D Effects &Off"
  23.       FontBold        =   -1  'True
  24.       FontItalic      =   0   'False
  25.       FontName        =   "MS Sans Serif"
  26.       FontSize        =   9.75
  27.       FontStrikethru  =   0   'False
  28.       FontUnderline   =   0   'False
  29.       Height          =   255
  30.       Index           =   1
  31.       Left            =   4560
  32.       TabIndex        =   6
  33.       Top             =   120
  34.       Width           =   1800
  35.    End
  36.    Begin OptionButton Option1 
  37.       BackColor       =   &H00C0C0C0&
  38.       Caption         =   "3&D Effects On"
  39.       FontBold        =   -1  'True
  40.       FontItalic      =   0   'False
  41.       FontName        =   "MS Sans Serif"
  42.       FontSize        =   9.75
  43.       FontStrikethru  =   0   'False
  44.       FontUnderline   =   0   'False
  45.       Height          =   255
  46.       Index           =   0
  47.       Left            =   2160
  48.       TabIndex        =   5
  49.       Top             =   120
  50.       Value           =   -1  'True
  51.       Width           =   1800
  52.    End
  53.    Begin CommonDialog CMDialog1 
  54.       Left            =   7080
  55.       Top             =   0
  56.    End
  57.    Begin CommandButton Command1 
  58.       Caption         =   "&Help"
  59.       FontBold        =   -1  'True
  60.       FontItalic      =   0   'False
  61.       FontName        =   "MS Sans Serif"
  62.       FontSize        =   9.75
  63.       FontStrikethru  =   0   'False
  64.       FontUnderline   =   0   'False
  65.       Height          =   495
  66.       Index           =   3
  67.       Left            =   120
  68.       TabIndex        =   4
  69.       Top             =   2280
  70.       Width           =   7935
  71.    End
  72.    Begin CommandButton Command1 
  73.       Caption         =   "&Common Dialog"
  74.       FontBold        =   -1  'True
  75.       FontItalic      =   0   'False
  76.       FontName        =   "MS Sans Serif"
  77.       FontSize        =   9.75
  78.       FontStrikethru  =   0   'False
  79.       FontUnderline   =   0   'False
  80.       Height          =   495
  81.       Index           =   2
  82.       Left            =   120
  83.       TabIndex        =   2
  84.       Top             =   1680
  85.       Width           =   7935
  86.    End
  87.    Begin CommandButton Command1 
  88.       Cancel          =   -1  'True
  89.       Caption         =   "E&xit"
  90.       FontBold        =   -1  'True
  91.       FontItalic      =   0   'False
  92.       FontName        =   "MS Sans Serif"
  93.       FontSize        =   9.75
  94.       FontStrikethru  =   0   'False
  95.       FontUnderline   =   0   'False
  96.       Height          =   495
  97.       Index           =   4
  98.       Left            =   120
  99.       TabIndex        =   3
  100.       Top             =   2880
  101.       Width           =   7935
  102.    End
  103.    Begin CommandButton Command1 
  104.       Caption         =   "&Input Box"
  105.       FontBold        =   -1  'True
  106.       FontItalic      =   0   'False
  107.       FontName        =   "MS Sans Serif"
  108.       FontSize        =   9.75
  109.       FontStrikethru  =   0   'False
  110.       FontUnderline   =   0   'False
  111.       Height          =   495
  112.       Index           =   1
  113.       Left            =   120
  114.       TabIndex        =   1
  115.       Top             =   1080
  116.       Width           =   7935
  117.    End
  118.    Begin CommandButton Command1 
  119.       Caption         =   "&Message Box"
  120.       FontBold        =   -1  'True
  121.       FontItalic      =   0   'False
  122.       FontName        =   "MS Sans Serif"
  123.       FontSize        =   9.75
  124.       FontStrikethru  =   0   'False
  125.       FontUnderline   =   0   'False
  126.       Height          =   495
  127.       Index           =   0
  128.       Left            =   120
  129.       TabIndex        =   0
  130.       Top             =   480
  131.       Width           =   7935
  132.    End
  133. End
  134. ' DemoCt3D.Frm - Demo calling Ctl3D.DLL/Ctl3DV2.DLL
  135. ' 94/08/06 Copyright 1994, Larry Rebich, The Bridge, Inc., CIS 71662,205
  136. ' 94/10/27 Clean-up and Bug in Determining if Ctl3Dv2.Dll on user's system
  137. ' 95/03/26 Use Ctl3D.DLL is Ctl3DV2 not found
  138.  
  139.     Option Explicit
  140.     DefInt A-Z
  141.  
  142. ' Command Indexes
  143.     Const IndexMsgBox = 0
  144.     Const IndexInputBox = 1
  145.     Const IndexCMDialog = 2
  146.     Const IndexHelp = 3
  147.     Const IndexExit = 4
  148.  
  149. ' Toggle 3D Effect
  150.     Dim Is3DOn As Integer   'True if 3D on
  151.  
  152. ' Option Buttons
  153.     Const IndexOption3DOn = 0
  154.     Const IndexOption3DOff = 1
  155.  
  156. Sub Command1_Click (Index As Integer)
  157.     ' process samples
  158.     Select Case Index
  159.         Case IndexMsgBox
  160.             MsgBox "Sample Message", 32, "The Title"
  161.         Case IndexInputBox
  162.             Dim Inpt As String
  163.             Inpt = InputBox("Sample Message:", "The Title", "Default Value")
  164.         Case IndexCMDialog
  165.             DoCmDialog
  166.         Case IndexHelp
  167.             DoHelpMessage           'some info
  168.         Case IndexExit
  169.             Unload Me               'bye and unregister if needed
  170.     End Select
  171. End Sub
  172.  
  173. Sub DoApp3D (Action)
  174. ' Toggle 3D Effect based upon the Action setting
  175.     Const SetCap = "&Set 3D "
  176.     Const SetOff = "Off"
  177.     Const SetOn = "On"
  178.     Const s3D = "3D &"
  179.     Const sStd = "Std &"
  180.     Const sMsg = "Message"
  181.     Const sInputBox = "InputBox"
  182.     Const sCommonDialog = "Command Dialog"
  183.     Const sHelpMessage = "Help Message"
  184.  
  185.     If Action Then          'true
  186.         Ctl3D_Start         'start 3D effect
  187.         Is3DOn = True
  188.         Command1(IndexMsgBox).Caption = s3D & sMsg
  189.         Command1(IndexInputBox).Caption = s3D & sInputBox
  190.         Command1(IndexCMDialog).Caption = s3D & sCommonDialog
  191.         Command1(IndexHelp).Caption = s3D & sHelpMessage
  192.         BackColor = RGB(192, 192, 192)
  193.     Else                    'false
  194.         Ctl3D_End           'end 3D effect
  195.         Is3DOn = False      'set switch
  196.         Command1(IndexMsgBox).Caption = sStd & sMsg
  197.         Command1(IndexInputBox).Caption = sStd & sInputBox
  198.         Command1(IndexCMDialog).Caption = sStd & sCommonDialog
  199.         Command1(IndexHelp).Caption = sStd & sHelpMessage
  200.         BackColor = RGB(255, 255, 255)
  201.     End If
  202.     Option1(0).BackColor = BackColor
  203.     Option1(1).BackColor = BackColor
  204. End Sub
  205.  
  206. Sub DoCmDialog ()
  207. ' Common File Open Dialog that does nothing
  208.     Dim Fltr As String                  'temporary filter
  209.     CmDialog1.DialogTitle = "Does Absolutely Nothing"
  210.     CmDialog1.Filename = "ctl3d.bas"
  211.     Fltr = "All (*.*)|*.*|Text (*.txt)|*.txt|"
  212.     Fltr = Fltr & "Forms (*.frm)|*.frm|"
  213.     Fltr = Fltr & "VB Projects (*.mak)|*.mak"
  214.     CmDialog1.Filter = Fltr             'file filter
  215.     CmDialog1.InitDir = App.Path        'initial path
  216.     CmDialog1.Action = 1    'open
  217. End Sub
  218.  
  219. Sub DoEndingMessage ()
  220. ' Add warning message that Ctl3DV2.DLL not Installed
  221.     Dim Msg As String
  222.     Dim Ttl As String
  223.     Dim Cr As String
  224.     Cr = Chr$(13)
  225.     Msg = "Ctl3DV2.DLL was not found on your system." & Cr
  226.     Msg = Msg & "Unable to demonstrate 3D effects without it." & Cr
  227.     Msg = Msg & "Contact the author [71662,205] if you have " & Cr
  228.     Msg = Msg & "trouble finding this DLL." & Cr & Cr
  229.     Msg = Msg & "Will End Now."
  230.     Ttl = "Ctl3DV2.DLL not Found"
  231.     MsgBox Msg, 16, Ttl
  232.     End
  233. End Sub
  234.  
  235. Sub DoHelpMessage ()
  236.     Dim Msg As String       'Message
  237.     Dim Ttl As String       'Title
  238.     Dim Cr As String * 1    'Carriage return
  239.     Cr = Chr$(13)
  240.     Msg = "This simple application demonstrates using Ctl3D.DLL or Ctl3DV2.DLL. "
  241.     Msg = Msg & "Ctl3DV2.DLL is used if found. Then Ctl3D.DLL. "
  242.     Msg = Msg & "The version used is shown in the form's caption." & Cr & Cr
  243.     Msg = Msg & "Click the option buttons to turn on or off "
  244.     Msg = Msg & "3D effects. "
  245.     Msg = Msg & Cr & Cr
  246.     Msg = Msg & "Click the Message, Input Box, or Common Dialog command "
  247.     Msg = Msg & "to see standard or 3D effects. "
  248.     Msg = Msg & Cr & Cr
  249.     Msg = Msg & "This demo is based upon work done by an unidentified author, CIS: 74047,2155." & Cr
  250.     Msg = Msg & "The demo was created on August 6, 1994"
  251.     Msg = Msg & " and updated on October 28,1994, "
  252.     Msg = Msg & "and March 26, 1995 "
  253.     Msg = Msg & "by Larry Rebich, CIS: 71662,205."
  254.     Ttl = "Demo Ctl3D Information"
  255.     MsgBox Msg, 64, Ttl
  256. End Sub
  257.  
  258. Sub Form_Load ()
  259.     If DoesCtl3DEitherExist() Then  'test for existance of Ctl3Dv2.Dll
  260.         DoApp3D True                'set 3D effect on
  261.     Else
  262.         DoEndingMessage
  263.     End If
  264.     'setup the forms
  265.     SetupForm
  266.     'center the form
  267.     Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
  268.     DoHelpMessage
  269. End Sub
  270.  
  271. Sub Form_Unload (Cancel As Integer)
  272.     ' Warning, Be Sure to end this with the Exit Button
  273.     ' or the Control Box, Close Menu Item or by using Alt-F4
  274.     If Is3DOn Then      'if 3D Effect on then turn it off
  275.         Ctl3D_End       'if not done then a GPF can occur
  276.     End If
  277. End Sub
  278.  
  279. Sub Option1_Click (Index As Integer)
  280.     If Index = IndexOption3DOn Then
  281.         DoApp3D True
  282.     Else
  283.         DoApp3D False
  284.     End If
  285. End Sub
  286.  
  287. Sub SetupForm ()
  288.     Dim i As Integer
  289.     Dim a As String
  290.     Dim c31h As Integer, c31l As Integer    'version numbers saved here
  291.     Dim c32h As Integer, c32l As Integer
  292.     Dim c31 As Single
  293.     Dim c32 As Single
  294.     WordToTwoIntegers VerV1, c31h, c31l     'get version numbers
  295.     WordToTwoIntegers VerV2, c32h, c32l
  296.     c31 = Val(Hex$(c31h)) + Val(Hex$(c31l)) / 100
  297.     c32 = Val(Hex$(c32h)) + Val(Hex$(c32l)) / 100
  298.     Const mm = "#0.00"
  299.     For i = IndexExit To IndexMsgBox Step -1
  300.         Command1(i).TabIndex = 0
  301.     Next
  302.     Dim ff As String, fd As Double
  303.     If DoesCtl3DExist(FileNameCtl3DV2) Then
  304.         GetFileFullNameAndDateTime FileNameCtl3DV2, ff, fd
  305.         a = Format$(c32, mm)
  306.     Else
  307.         GetFileFullNameAndDateTime FileNameCtl3DV1, ff, fd
  308.         a = Format$(c31, mm)
  309.     End If
  310.     Caption = "Using " & LCase$(ff) & ", " & a & ", " & Format$(fd, "ddddd, ttttt")
  311. End Sub
  312.  
  313. Sub WordToTwoIntegers (TheWord As Integer, TheIntHigh As Integer, TheIntLow As Integer)
  314.     TheIntHigh = TheWord \ 256
  315.     TheIntLow = TheWord - (256 * TheIntHigh)
  316. End Sub
  317.  
  318.